home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / os2 / octa209s.zip / octave-2.09 / libcruft / blas / zhemv.f < prev    next >
Text File  |  1997-06-25  |  9KB  |  270 lines
  1. *
  2. ************************************************************************
  3. *
  4.       SUBROUTINE ZHEMV ( UPLO, N, ALPHA, A, LDA, X, INCX,
  5.      $                   BETA, Y, INCY )
  6. *     .. Scalar Arguments ..
  7.       COMPLEX*16         ALPHA, BETA
  8.       INTEGER            INCX, INCY, LDA, N
  9.       CHARACTER*1        UPLO
  10. *     .. Array Arguments ..
  11.       COMPLEX*16         A( LDA, * ), X( * ), Y( * )
  12. *     ..
  13. *
  14. *  Purpose
  15. *  =======
  16. *
  17. *  ZHEMV  performs the matrix-vector  operation
  18. *
  19. *     y := alpha*A*x + beta*y,
  20. *
  21. *  where alpha and beta are scalars, x and y are n element vectors and
  22. *  A is an n by n hermitian matrix.
  23. *
  24. *  Parameters
  25. *  ==========
  26. *
  27. *  UPLO   - CHARACTER*1.
  28. *           On entry, UPLO specifies whether the upper or lower
  29. *           triangular part of the array A is to be referenced as
  30. *           follows:
  31. *
  32. *              UPLO = 'U' or 'u'   Only the upper triangular part of A
  33. *                                  is to be referenced.
  34. *
  35. *              UPLO = 'L' or 'l'   Only the lower triangular part of A
  36. *                                  is to be referenced.
  37. *
  38. *           Unchanged on exit.
  39. *
  40. *  N      - INTEGER.
  41. *           On entry, N specifies the order of the matrix A.
  42. *           N must be at least zero.
  43. *           Unchanged on exit.
  44. *
  45. *  ALPHA  - COMPLEX*16      .
  46. *           On entry, ALPHA specifies the scalar alpha.
  47. *           Unchanged on exit.
  48. *
  49. *  A      - COMPLEX*16       array of DIMENSION ( LDA, n ).
  50. *           Before entry with  UPLO = 'U' or 'u', the leading n by n
  51. *           upper triangular part of the array A must contain the upper
  52. *           triangular part of the hermitian matrix and the strictly
  53. *           lower triangular part of A is not referenced.
  54. *           Before entry with UPLO = 'L' or 'l', the leading n by n
  55. *           lower triangular part of the array A must contain the lower
  56. *           triangular part of the hermitian matrix and the strictly
  57. *           upper triangular part of A is not referenced.
  58. *           Note that the imaginary parts of the diagonal elements need
  59. *           not be set and are assumed to be zero.
  60. *           Unchanged on exit.
  61. *
  62. *  LDA    - INTEGER.
  63. *           On entry, LDA specifies the first dimension of A as declared
  64. *           in the calling (sub) program. LDA must be at least
  65. *           max( 1, n ).
  66. *           Unchanged on exit.
  67. *
  68. *  X      - COMPLEX*16       array of dimension at least
  69. *           ( 1 + ( n - 1 )*abs( INCX ) ).
  70. *           Before entry, the incremented array X must contain the n
  71. *           element vector x.
  72. *           Unchanged on exit.
  73. *
  74. *  INCX   - INTEGER.
  75. *           On entry, INCX specifies the increment for the elements of
  76. *           X. INCX must not be zero.
  77. *           Unchanged on exit.
  78. *
  79. *  BETA   - COMPLEX*16      .
  80. *           On entry, BETA specifies the scalar beta. When BETA is
  81. *           supplied as zero then Y need not be set on input.
  82. *           Unchanged on exit.
  83. *
  84. *  Y      - COMPLEX*16       array of dimension at least
  85. *           ( 1 + ( n - 1 )*abs( INCY ) ).
  86. *           Before entry, the incremented array Y must contain the n
  87. *           element vector y. On exit, Y is overwritten by the updated
  88. *           vector y.
  89. *
  90. *  INCY   - INTEGER.
  91. *           On entry, INCY specifies the increment for the elements of
  92. *           Y. INCY must not be zero.
  93. *           Unchanged on exit.
  94. *
  95. *
  96. *  Level 2 Blas routine.
  97. *
  98. *  -- Written on 22-October-1986.
  99. *     Jack Dongarra, Argonne National Lab.
  100. *     Jeremy Du Croz, Nag Central Office.
  101. *     Sven Hammarling, Nag Central Office.
  102. *     Richard Hanson, Sandia National Labs.
  103. *
  104. *
  105. *     .. Parameters ..
  106.       COMPLEX*16         ONE
  107.       PARAMETER        ( ONE  = ( 1.0D+0, 0.0D+0 ) )
  108.       COMPLEX*16         ZERO
  109.       PARAMETER        ( ZERO = ( 0.0D+0, 0.0D+0 ) )
  110. *     .. Local Scalars ..
  111.       COMPLEX*16         TEMP1, TEMP2
  112.       INTEGER            I, INFO, IX, IY, J, JX, JY, KX, KY
  113. *     .. External Functions ..
  114.       LOGICAL            LSAME
  115.       EXTERNAL           LSAME
  116. *     .. External Subroutines ..
  117.       EXTERNAL           XERBLA
  118. *     .. Intrinsic Functions ..
  119.       INTRINSIC          DCONJG, MAX, DBLE
  120. *     ..
  121. *     .. Executable Statements ..
  122. *
  123. *     Test the input parameters.
  124. *
  125.       INFO = 0
  126.       IF     ( .NOT.LSAME( UPLO, 'U' ).AND.
  127.      $         .NOT.LSAME( UPLO, 'L' )      )THEN
  128.          INFO = 1
  129.       ELSE IF( N.LT.0 )THEN
  130.          INFO = 2
  131.       ELSE IF( LDA.LT.MAX( 1, N ) )THEN
  132.          INFO = 5
  133.       ELSE IF( INCX.EQ.0 )THEN
  134.          INFO = 7
  135.       ELSE IF( INCY.EQ.0 )THEN
  136.          INFO = 10
  137.       END IF
  138.       IF( INFO.NE.0 )THEN
  139.          CALL XERBLA( 'ZHEMV ', INFO )
  140.          RETURN
  141.       END IF
  142. *
  143. *     Quick return if possible.
  144. *
  145.       IF( ( N.EQ.0 ).OR.( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) )
  146.      $   RETURN
  147. *
  148. *     Set up the start points in  X  and  Y.
  149. *
  150.       IF( INCX.GT.0 )THEN
  151.          KX = 1
  152.       ELSE
  153.          KX = 1 - ( N - 1 )*INCX
  154.       END IF
  155.       IF( INCY.GT.0 )THEN
  156.          KY = 1
  157.       ELSE
  158.          KY = 1 - ( N - 1 )*INCY
  159.       END IF
  160. *
  161. *     Start the operations. In this version the elements of A are
  162. *     accessed sequentially with one pass through the triangular part
  163. *     of A.
  164. *
  165. *     First form  y := beta*y.
  166. *
  167.       IF( BETA.NE.ONE )THEN
  168.          IF( INCY.EQ.1 )THEN
  169.             IF( BETA.EQ.ZERO )THEN
  170.                DO 10, I = 1, N
  171.                   Y( I ) = ZERO
  172.    10          CONTINUE
  173.             ELSE
  174.                DO 20, I = 1, N
  175.                   Y( I ) = BETA*Y( I )
  176.    20          CONTINUE
  177.             END IF
  178.          ELSE
  179.             IY = KY
  180.             IF( BETA.EQ.ZERO )THEN
  181.                DO 30, I = 1, N
  182.                   Y( IY ) = ZERO
  183.                   IY      = IY   + INCY
  184.    30          CONTINUE
  185.             ELSE
  186.                DO 40, I = 1, N
  187.                   Y( IY ) = BETA*Y( IY )
  188.                   IY      = IY           + INCY
  189.    40          CONTINUE
  190.             END IF
  191.          END IF
  192.       END IF
  193.       IF( ALPHA.EQ.ZERO )
  194.      $   RETURN
  195.       IF( LSAME( UPLO, 'U' ) )THEN
  196. *
  197. *        Form  y  when A is stored in upper triangle.
  198. *
  199.          IF( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) )THEN
  200.             DO 60, J = 1, N
  201.                TEMP1 = ALPHA*X( J )
  202.                TEMP2 = ZERO
  203.                DO 50, I = 1, J - 1
  204.                   Y( I ) = Y( I ) + TEMP1*A( I, J )
  205.                   TEMP2  = TEMP2  + DCONJG( A( I, J ) )*X( I )
  206.    50          CONTINUE
  207.                Y( J ) = Y( J ) + TEMP1*DBLE( A( J, J ) ) + ALPHA*TEMP2
  208.    60       CONTINUE
  209.          ELSE
  210.             JX = KX
  211.             JY = KY
  212.             DO 80, J = 1, N
  213.                TEMP1 = ALPHA*X( JX )
  214.                TEMP2 = ZERO
  215.                IX    = KX
  216.                IY    = KY
  217.                DO 70, I = 1, J - 1
  218.                   Y( IY ) = Y( IY ) + TEMP1*A( I, J )
  219.                   TEMP2   = TEMP2   + DCONJG( A( I, J ) )*X( IX )
  220.                   IX      = IX      + INCX
  221.                   IY      = IY      + INCY
  222.    70          CONTINUE
  223.                Y( JY ) = Y( JY ) + TEMP1*DBLE( A( J, J ) ) + ALPHA*TEMP2
  224.                JX      = JX      + INCX
  225.                JY      = JY      + INCY
  226.    80       CONTINUE
  227.          END IF
  228.       ELSE
  229. *
  230. *        Form  y  when A is stored in lower triangle.
  231. *
  232.          IF( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) )THEN
  233.             DO 100, J = 1, N
  234.                TEMP1  = ALPHA*X( J )
  235.                TEMP2  = ZERO
  236.                Y( J ) = Y( J ) + TEMP1*DBLE( A( J, J ) )
  237.                DO 90, I = J + 1, N
  238.                   Y( I ) = Y( I ) + TEMP1*A( I, J )
  239.                   TEMP2  = TEMP2  + DCONJG( A( I, J ) )*X( I )
  240.    90          CONTINUE
  241.                Y( J ) = Y( J ) + ALPHA*TEMP2
  242.   100       CONTINUE
  243.          ELSE
  244.             JX = KX
  245.             JY = KY
  246.             DO 120, J = 1, N
  247.                TEMP1   = ALPHA*X( JX )
  248.                TEMP2   = ZERO
  249.                Y( JY ) = Y( JY ) + TEMP1*DBLE( A( J, J ) )
  250.                IX      = JX
  251.                IY      = JY
  252.                DO 110, I = J + 1, N
  253.                   IX      = IX      + INCX
  254.                   IY      = IY      + INCY
  255.                   Y( IY ) = Y( IY ) + TEMP1*A( I, J )
  256.                   TEMP2   = TEMP2   + DCONJG( A( I, J ) )*X( IX )
  257.   110          CONTINUE
  258.                Y( JY ) = Y( JY ) + ALPHA*TEMP2
  259.                JX      = JX      + INCX
  260.                JY      = JY      + INCY
  261.   120       CONTINUE
  262.          END IF
  263.       END IF
  264. *
  265.       RETURN
  266. *
  267. *     End of ZHEMV .
  268. *
  269.       END
  270.